home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
os2
/
srefv112.zip
/
GETAFILE.80
< prev
next >
Wrap
Text File
|
1996-05-14
|
30KB
|
906 lines
/*********************************
GETAFILE : Displays files in a selected subdirectory (of the data
directory, and allows you to retrieve a file.
Usage: Set up a link with href="/getafile?DIR=/adir&option1&option."
where adir is the directory (under the data directory
in GOSERVE) whose files will be displayed.
By default,only files in the directory will be displayed
Options understood by GETAFILE:
: DIR=dirname .
Dirname is actually the subdirectory under the
data directory (data directory is often /GOHTTP).
Thus, DIR=/ means "display contents of Data directory"
Note: if DIR= is missing, then defaults to data directory.
: ISCREATE=amessage.
If ISCREATE is present, then suppress all descriptive information
except an H2 of amessage.
: SHOWDIR=YES.
Display subdirectories
as links back to GETAFILE (allows you to traverse the
directory tree). Parent is also included, but NOT if
DIR=/ (that is, the root of the data directory can not
be gotten below).
: ROOTDIR=rootname
If you don't want the client to be able to view files beneath some
root directory, enter it here. Note that ROOTNAME must be an
abbreviation of DIR (otherwise, DIR will not be displayed)
To specify the DIR as the ROOTDIR (on first call to GETAFILE), enter
ROOTDIR=!
If no ROOTDIR restriction is desired, set ROOTDIR=0 (or leave it out)
: header=a+header+
The message string will be inserted as an <H2> at the
top of the document.
For example, message string could be
(From+our+staff) == note the use of URL encoding!
If not specified, a default header is used (you should set HEADER=0, or
leave HEADER out)
: DISPFILE=filename.ext+Message+about+file
Displays the contents of filename along with the
filelist. DISPFILE is assumed to be in DIR.
The Message about the file is displayed using a <H3>
: LINES=nlines
displays no more then nlines from filename
: TOP=YES
display file before filelist (default is after)
: GIFS=YES
Put a cute gif next to
the filename (or directory). This idea (and icons)
are "borrowed" from the GOHTTP server package of Don Meyer.
: TABLE = DIR, FILE, or KEY
Write stuff in a table.
DIR = Put the files & subdirectories in column 2-tablecols,
FILES = Create a 3 column table,
column 1 = file & directory names
column 2,3 = File size and file datd
column 4 = Line from 'dispfile' filename
(actually, this is subject to SHOWDATE and SHOWSIZE)
KEY. Similar to FILE, but instead of displaying
the ith line of filename in the ith row of the
table, a Key search is performed on filename,
where the key being looked for is
{afile.1a} xx {afile.2} etc. If the file
name (in column 1) matches this key (i.e. afile.1a)
then xxx is displayed in column 3.
If no TABLEFILE selected, then column 4 is blank.
: TABLEFILE=FILENAME+a+Message
Used if TABLE=KEY or TABLE=FILE (contains info on each file & directory)
: TABLECOLS= # colums
By default, equals 4 (used only if TABLE=DIR)
If set to 0, then use a <DL> list (useful if TABLE is
not supported).
: USEDL = YES or NO
If TABLE =FILE or KEY, and USEDL=YES, then
use a <DL> list instead of a table.
: DISPFILE=filename.ext
Displays the contents of filename along with the
filelist. DISPFILE is assumed to be in DIR.
: IMGDIR=director
If IMGDIR, then the cute gifs are expected to be
in the /IMGS subdirectory of the data directory
(hint: specify this as a hidden element in a form).
example: imgdir="/IMGS2" would look in d:/gohttp/imgs2 if
d:/gohttp were your datadirectory
If IMGDIR not specified, then the cute gifs are assumed
to be in data_directory/IMGS
: SHOWDATE = YES
Display the file creation date.
: SHOWSIZE = YES
Display the file's size
: RECORD=YES
Use the SENDFILE procedure to record/control
file has been transfer. See documentation
of SENDFILE for details. You probably want to
make this a hidden element.
: ACCESS=access_code
Used if RECORD=YES, as access control information.
: FORCETEXT=YES or NO
If YES, SENDFILE assumes ALL files are text/plain mime type
Example:
/getafile?/public&header=Public+Files&dispfile=READ.ME&displine=40&GIFS&dirs
Would find all files in /public (relative to the
data directory), write a H2 header of "Public Files"
display the READ.ME file, and note the files with a gif.
NOTE: If your client's browser does not support tables,
the TABLE option is a bad idea!
Note that for security, only files and directories under the
working directory are accessible (the .. syntax is ignored).
Also, if you are controlling access to files using RECORD=YES
(that is, using the SENDFILE facility to determine who has rights
to download the file), then any clever idiot could simply remove the
RECORD=YES option, and thereby sidestep the call to SENDFILE.
So... don't use this if security is truely important!!
************************/
getafile:
parse arg ddir,tempfile,sel,list,averb,auri,auser,abd,awd,apri,infiles
list=translate(list, ' ', '+'||'090a0d'x) /* Whitespace, etc. */
parse var infiles params ',' access_file ',' userfile ',' virtual_file ',' alias_file ',' sendfile_file
parse upper var params allow_access nog macrospace_input
userfile=strip(userfile) ; access_file=strip(access_file);
virtual_file=strip(virtual_file) ; alias_file=strip(alias_file)
sendfile_file=strip(sendfile_file)
imagepath=translate("/imgs/")
imagesize="width=24 height=24"
list=packur(list) /* fix up */
dirgif='<img src="'ImagePath'menu.gif"' size 'alt="[dir] ">'
backgif='<img src="'ImagePath'back.gif"' size 'alt="[..] ">'
/* since we might use tables, use netscape dtd rather the 2.0 */
call lineout tempfile,' <!DOCTYPE HTML PUBLIC "-//Netscape Comm. Corp.//DTD HTML//EN">'
call lineout tempfile, "<html><head><title>Upload a File</title></head>"
call lineout tempfile, "<body>"
/* retain old message (a record of directory traverses */
oldmess=list
oldmess=translate(oldmess,'+',' ')
if left(oldmess,4)="DIR=" then do
foo1=pos('&',oldmess)
oldmess=delstr(oldmess,1,foo1)
end
else do
foo1=pos("&DIR=",oldmess)
if foo1>0 then do
foo2=pos('&',oldmess,foo1+1)
if foo2>0 then
oldmess=delstr(oldmess,foo1+1,foo2-foo1)
end
end
oldmess='&'||oldmess
messages=list
/* Get options */
showgifs=0 ; maxlines=1000000 ; readmefile=0
attop=0 ; dirtable=0 ; filetable=0 ;defcols=4
dodirs=0 ; header=0; filekey=0 ; dorecord=0
access_code='na' ; showdate=0; showsize=0
forcetext=0 ; tablefile=0 ; usedl=0 ; rootdir=0 ;
readmefile_mess=0 ; dirtop=0
tablefile_mess=0 ; iscreate=0
adir="/"
do until messages=" "
parse var messages amess '&' messages
parse var amess messname '=' messval
messval=packur(translate(messval,' ','+'||'0d0a09'x))
messname=translate(messname) ; messval=translate(messval)
select
when "DIR"=messname then
adir=messval
when message="IMGDIR" then do
messval="/"||strip(messval,,'\')||"/"
imagepath=translate(messval,'/'.'\')
end
when messname="HEADER" then
header=messval
when messname="GIFS" then
if messval="YES" then
showgifs=1
when messname="DISPFILE" then do
tmp=messval
if tmp="" | tmp=0 then
readmefile=0
else
parse var tmp readmefile readmefile_mess
if readmefile_mess="" then readmefile_Mess=0
end
when messname="TABLEFILE" then do
tmp=messval
if tmp=" " | tmp="" then
tablefile=0
else
parse var tmp tablefile tablefile_mess
if tablefile_mess="" then tablefile_Mess=0
end
when messname="TABLE" then
select
when pos("KEY",messval)>0 then do
filetable=1
filekey=1
end
when pos("FILE",messval)>0 then do
filetable=1
filekey=0
end
when pos("DIR",messval)>0 then
dirtable=1
otherwise
end
WHEN MESSNAME="RECORD" THEN
IF messval="YES" then dorecord=1
WHEN MESSNAME="SHOWDATE" THEN
IF messval="YES" then showdate=1
WHEN MESSNAME="SHOWSIZE" THEN
IF messval="YES" then showsize=1
when messname="COLS" then
if datatype(messval)="NUM" then tablecols=messval
when messname="ISCREATE" then do
header=messval
iscreate=1
end
when messname="USEDL" then
IF messval="YES" then usedl=1
when messname="ROOTDIR" then
rootdir=messval
when pos("LINE",messname)>0 then
if datatype(messval)="NUM" then maxlines=messval
when pos("TOP",messname) > 0 then
if messval="YES" then attop=1
when pos("SHOWDIR",messname)>0 | pos("SUBDIR",messname)>0 then do
dodirs=1
if messval="TOP" then
dirtop=1
end
when messname="USERNAME" | messname="ACCESS" then do
access_code=messval
if access_code="" then access_code="na"
end
when messname="FORCETEXT" then
if messval=1 | abbrev(messval,'Y')=1 then forcetext=1
otherwise
end /* select messname */
end /* loop */
adir=translate(strip(adir),'/','\')
adir=strip(adir,'t','/')
foodir=adir
if abbrev(translate(rootdir),"!")=1 then rootdir=foodir
if datatype(tablecols)<>"NUM" then /* default # table columns */
tablecols=defcols-showgifs
if header="" | header=0 then header=' List of files in ' ||foodir
if tablecols=0 & dirtable=1 then tablecols=1
/* lookdir2=translate(adir,'\','/')*/
lookdir2=adir
tmp=lookdir2||'/*.*'
lookin=sref_do_virtual(ddir,tmp,macrospace_input,virtual_file)
dp=strip(filespec('d',lookin)||filespec('p',lookin),'t','\')
wade=directory()
notwade=directory(dp)
wade0=directory(wade)
if lookin = " " | lookin=0 | notwade="" then do /* ERROR */
call error_0
return 'FILE ERASE TYPE text/html NAME' tempfile
end
/* if here, directory exists so get its files and subds */
rc = SysFileTree(lookin,'flist', 'F')
if rc <> 0 then do /* error */
call error_1
return 'FILE ERASE TYPE text/html NAME' tempfile
end
thepath=delstr(lookin,pos('\*.*',lookin))
say " Getting files from " thepath
/* Else, create list of links to files */
do i=1 to flist.0
parse var flist.i adate ee2 asize ee3 fname
if asize>99999 then do
asize=trunc(asize/1000)||'K'
end
afil=filespec("name",fname)
flist.i.afile=afil
flist.i.size=asize
flist.i.date=adate
afil2=adir||"/"||afil
if dorecord=1 then
afil2="SENDFILE?"||afil2||'&ACCESS='||access_code||'&FORCETEXT='||forcetext
if filetable=1 & tablefile<>0 & usedl=0 then /*force size/date in own column*/
if showgifs=1 then do
agif=imagetype(afil)
flist.i.name=' ' agif ' <a href="' || afil2|| '>' afil '</a> '
end
else
flist.i.name=' <a href="' || afil2|| '">' afil '</a> '
else do /* put size/date with name */
jasize=asize ; if showsize=0 then jasize=' '
jadate=adate ; if showdate=0 then jadate= ' '
dl1='(' ; dl2=',' ; dl3=')' ;
if jadate=' ' & jasize=' ' then do ; dl1=' ' ; dl2=' '; dl3=' '; end
if jasize=' ' then dl2=' '
if jadate=' ' then dl2=' '
if showgifs=1 then do
agif=imagetype(afil)
flist.i.name=' ' agif ' <a href="' || afil2|| '">' afil '</a>' ,
dl1 jasize dl2 jadate dl3
end
else
flist.i.name=' <a href="' || afil2|| '">' afil '</a> ' ,
dl1 jasize dl2 jadate dl3
end /* put size/date */
end /* i 1 to flist.0 */
oldmess2=oldmess
/* replace DIR= with OLDDIR= (retained for grins, not actually used by getafile) */
oldmess2=sref_replacestrg(oldmess2,'&DIR=','&DIROLD=')
if abbrev(oldmess2,'DIR=')=1 then
oldmess2=sref_replacestrg(oldmess2,'DIR=','DIROLD=') /* just do the first one */
/*replace ROOTDIR="!" with ROOTDIR=rootdir (the variable's value) */
oldmess2=sref_replacestrg(oldmess2,'=!','='||rootdir)
/* get subdirectories ? */
if dodirs=1 then do
rc2=sysfiletree(lookin,dirlist,"OD")
if rc2 <> 0 then do /* error */
call error_3
return 'FILE ERASE TYPE text/html NAME' tempfile
end
do mm=1 to dirlist.0
parse var dirlist.mm (thepath) teco
dirlist.mm=translate(adir||teco,'/','\')
end
/* create list of directories, and add the .. directory if needed */
LP1=LASTPOS('/',ADIR)
do mm=dirlist.0 to 1 by -1 /* move 'em down */
if adir<>"" then
mm1=mm+1
else
mm1=mm
dirlist.mm1=dirlist.mm
dirg=dirlist.mm1
dirg0=translate(dirg,' ','/\'); dirg0=word(dirg0,words(dirg0))
dirlist.mm1.aname=dirg
dirg2=translate(dirg,'/','\')
dirg2="/GETAFILE?DIR="||dirg2||oldmess2
if showgifs=1 then
dirlist.mm1.name=' ' dirgif ' <a href="' ||dirg2|| '"> '|| dirg0 || ' </a>'
else
dirlist.mm1.name=' <a href="' ||dirg2|| '"> '|| dirg0 || ' </a>'
end
if adir<>"" then do /* if not at root */
dirlist.0=dirlist.0+1
IF LP1>1 THEN DO ; /*below first level subdirectory */
DIRG1=SUBSTR(ADIR,1,LP1-1) ;
dirlist.1.aname=dirg1
dirlist.1=dirg1
if showgifs=1 then
dirlist.1.name=' ' dirgif ' <A HREF="/GETAFILE?DIR='||DIRG1||oldmess2'"> (.. parent) </A>'
else
dirlist.1.name=' <A HREF="/GETAFILE?DIR='||DIRG1||oldmess2'"> (.. parent) </A>'
END
ELSE do /* must be 1st level directory, so display root */
dirlist.1=""
if showgifs=1 then
dirlist.1.name=' ' backgif ' <A HREF="/GETAFILE?DIR=/'||oldmess2||'"> .. (parent) </A>'
else
dirlist.1.name=' <A HREF="/GETAFILE?DIR=/'||oldmess2||'"> .. (parent) </A>'
dirlist.1.aname=""
end
END /* add parent */
/* rootdir condition check */
rootdir=strip(rootdir); rootdir=translate(rootdir,'/','\')
rootdir=strip(rootdir,,'/')
do m=1 to dirlist.0
if rootdir<>0 then do
t1=translate(dirlist.m.aname,'/','\')
t2=strip(dirlist.m.aname,,'/')
dirlist.ok.m=abbrev(t2,rootdir)
end
else
dirlist.ok.m=1
end
end /* dodirs */
/* read in the file, if wanted */
readmelines.0=0
if readmefile<>0 then do
yow=thepath||'\'||readmefile
nlines=fileread(yow,'filelines')
readmelines.0=nlines
if nlines>0 then
do pp=1 to nlines
readmelines.pp=filelines.pp
end
else do
readmefile=0 /* signal no success */
say " Could not find " readmefile
end
end
if tablefile<>0 & filekey=1 then do /*key matching table */
dispdata=sref_grab_file(thepath||'\'tablefile,30)
if dispdata=0 then do
tablefile=0 ; tablefile_mess=0
dispdata=""
end
end
tablelines.0=0
if tablefile<>0 & filetable=1 & filekey=0 then do /* line matching table */
yow=thepath||'\'||tablefile
nlines=fileread(yow,'filelines')
tablelines.0=nlines
if nlines=0 then do
tablefile=0 ; tablefile_mess=0
end
else
do pp=1 to nlines
tablelines.pp=filelines.pp
end
end
/* intro to this htm */
call lineout tempfile,'<h2> ' header ' </h2>'
if readmefile<>0 & attop=1 then do
call showdafile(readmelines.0)
end
if iscreate=0 then do
call lineout tempfile," <strong> " FLIST.0 " Files in " foodir " </strong> "
CAll lineout tempfile," <p> Select the file you want to retrieve "
call lineout tempfile,' <em> You might need to turn on your browser''s "Save to file mode" option </em>'
end
/*** table stuff complicates things !! */
select
/* no table */
when dirtable+filetable=0 then do /* no table */
if dodirs=1 & dirtop=1 then do
if iscreate<>1 then do
if adir="" then
call lineout tempfile, " <hr> <h3> Subdirectories </h3>"
else
call lineout tempfile, " <hr> <h3> Subdirectories of " adir ' </h3>'
end
else
call lineout tempfile," <br> "
call lineout tempfile, " <menu> "
if dirlist.0=0 then
call lineout tempfile,' <LI> No subdirectories! '
else
do mm=1 to dirlist.0
if dirlist.ok.mm=1 then
call lineout tempfile,' <li> ' dirlist.mm.name
end
call lineout tempfile,' </menu> '
end /* dirall */
if iscreate=0 then
call lineout tempfile, " <hr> <h3> Files </h3>"
call lineout tempfile,' <menu> '
IF FLIST.0=0 THEN
CALL LINEOUT TEMPFILE,' <li> No files in ' adir
else
do jj=1 to flist.0
call lineout tempfile, '<li> ' flist.jj.name
end
call lineout tempfile,' </menu> <hr> '
if dodirs=1 & dirtop=0 then do
if iscreate<>1 then do
if adir="" then
call lineout tempfile, " <h3> Subdirectories </h3>"
else
call lineout tempfile, " <h3> Subdirectories of " adir ' </h3>'
end
else
call lineout tempfile,' <br> '
call lineout tempfile, " <menu> "
if dirlist.0=0 then
call lineout tempfile,' <LI> No subdirectories! '
else
do mm=1 to dirlist.0
if dirlist.ok.mm=1 then
call lineout tempfile,' <li> ' dirlist.mm.name
end
call lineout tempfile,' </menu> '
end /* dirall */
end /* no table section */
/* table of files and subds */
when dirtable=1 then do
/* setup a multi column table:: file names first, then subdirectories. */
call lineout tempfile, " <table border=0> "
if showsize=1 & showdate=1 then
call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories (size, date)'
else if showsize=1 then
call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories (size)'
else if showdate=1 then
call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories (date)'
else
call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories '
call lineout tempfile, '<tr> '
ifoo=0
do mm=1 to flist.0
ifoo=ifoo+1
call lineout tempfile,'<td> ' flist.mm.name '</td> '
if ifoo>=tablecols then do
call lineout tempfile,' <tr> '
ifoo=0
end
end
if dodirs=1 then do
ifoo=ifoo+1
call lineout tempfile,'<td align="center"> :::: </td> '
if ifoo>=tablecols then do
call lineout tempfile,' <tr> '
ifoo=0
end
do mm=1 to dirlist.0
if dirlist.ok.mm=0 then iterate
ifoo=ifoo+1
call lineout tempfile,'<td> <b> ' dirlist.mm.name ' </b> </td>'
if ifoo>=tablecols then do
call lineout tempfile,' <tr> '
ifoo=0
end
end
end
call lineout tempfile,' </table> '
end
/*table of file&subds, displayed file */
when filetable=1 then do
foo1=""
if tablefile<>0 then
if tablefile_mess<>0 then
foo1=tablefile_mess
else
foo1='Description from:'||tablefile
if usedl=0 then do
call lineout tempfile, " <table border=1> "
call lineout tempfile, ' <th ALIGN="center"> files and subdirectories '
if showsize=1 then call lineout tempfile,' <th align="center"> <tt> size </tt> '
if showdate=1 then call lineout tempfile,' <th align="center"> <tt> date </tt> '
if filekey=1 then
if tablefile<>0 then
call lineout tempfile, ' <th ALIGN="center"> ' foo1
ELSE
call lineout tempfile, ' <th ALIGN="left"> '
else
if tablefile<>0 then
call lineout tempfile, ' <th ALIGN="left"> ' foo1
else
call lineout tempfile, ' <th ALIGN="left"> '
call lineout tempfile, '<tr> '
end
else do /* set up a dl */
if foo1<>" " then
call lineout tempfile,' <p> Files and directories (' foo1 ")"
else
call lineout tempfile,' <p> Files and directories '
call lineout tempfile ,'<p> <dl> '
end
IDONE=0
do igoo=1 to flist.0
if usedl=1 then do
if filekey=0 then
if igoo<=tablelines.0 then
gotit=tablelines.igoo
else
gotit=' '
else
gotit=sref_extract_block(dispdata,flist.igoo.afile,'{','}')
call lineout tempfile,'<dt> ' flist.igoo.name
call lineout tempfile,'<dd> <code> ' gotit '</code> '
iterate
end
/* else, use a table, not a dl list */
call lineout tempfile,'<td> ' Flist.igoo.name '</td>'
if showsize=1 then call lineout tempfile,'<td> ' Flist.igoo.size '</td>'
if showdate=1 then call lineout tempfile,'<td> ' Flist.igoo.date '</td>'
IDONE=IDONE+1
/* display lines as found (one line per cell */
if filekey=0 then do
IF IDONE=1 & tableLINES.0=0 THEN
CALL LINEOUT TEMPFILE,' <TD> </td> '
else
IF tableLINES.0 >= IGOO THEN
call lineout tempfile,'<td> <code> ' tablelines.igoo '</code> </td> '
CALL LINEOUT TEMPFILE,' <TR> '
end
/* seach file for a key */
else do /* use keyed {xx} search */
gotit=sref_extract_block(dispdata,flist.igoo.afile,'{','}')
if gotit="" then
if tablefile<>0 then
call lineout tempfile,' <td> </td> <tr>'
else
call lineout tempfile,' <td> </td> <tr>'
else do
call lineout tempfile,' <td> ' gotit ' </td> <tr> '
end
end
end
if usedl=0 then
CALL LINEOUT TEMPFILE,' <td> ------ </td> <td> </td> <TR> '
else
call lineout tempfile,' <p> '
if dodirs=1 then do
do igoo=1 to DIRlist.0
if dirlist.ok.igoo=0 then iterate
if usedl=1 then do
tooth=igoo+flist.0
if filekey=0 then
if tooth<=tablelines.0 then
gotit=tablelines.tooth
else
gotit=' '
else
gotit=sref_extract_block(dispdata,dirlist.igoo.aname,'{','}')
call lineout tempfile,'<dt> ' dirlist.igoo.name
call lineout tempfile,'<dd> <code> ' gotit '</code> '
iterate
end
/* else, use a table, not a dl */
call lineout tempfile,'<td> ' DIRlist.igoo.name '</td>'
idone=idone+1
if filekey=0 then do
IF IDONE=1 & tableLINES.0=0 THEN
CALL LINEOUT TEMPFILE,' <TD> <EM> No such file (or empty) </em> '
else do
tooth=igoo+flist.0
IF tableLINES.0 >= tooth THEN
call lineout tempfile,'<td> <code> ' tablelines.tooth '</code> </td> '
end
CALL LINEOUT TEMPFILE,' <TR> '
end
else do /* keyed read.me file */
gotit=sref_extract_block(dispdata,dirlist.igoo.aname,'{','}')
if gotit="" then
call lineout tempfile,' <td> </td> <tr>'
else do
call lineout tempfile,' <td> ' gotit ' </td> <tr> '
end
end
end /* dirlist.0 */
end /* DO DIRS */
if usedl=1 then
call lineout tempfile,' </dl> '
else
call lineout tempfile,' </table> '
END /* FILETABLE=1 */
otherwise
end
if readmefile<>0 & attop=0 then do
call showdafile(readmelines.0)
end
if iscreate=1 then do
call lineout tempfile,' <p><em> ' servername() adir '</em>'
end
call lineout tempfile,' </body> </html> '
call lineout tempfile
return 'FILE ERASE TYPE text/html NAME' tempfile
/*******/
/* IMAGETYPE: Return the name of the image file to use based on file type */
/*******/
imagetype: procedure expose ImagePath ImageSize
size = ImageSize
e=extension(arg(1))
select
when e='TXT' | e='CMD' | e='DOC' | e='FAQ' | e='SAS'
then return '<img src="'ImagePath'text.gif"' size 'alt="[text]">'
when e='HTM' | e='HTML'
then return '<img src="'ImagePath'text.gif"' size 'alt="[html]">'
when e='PS'
then return '<img src="'ImagePath'text.gif"' size 'alt="[ps] ">'
when e='EXE' | e='ZIP' | e='ARC' | e='ARJ'
then return '<img src="'ImagePath'binary.gif"' size 'alt="[bin] ">'
when e="AU" | e="WAV" | e="MID" | e="SND"
then return '<img src="'ImagePath'sound.gif"' size 'alt="[snd] ">'
when e="GIF" | e="JPG" | e="JPEG" | e="TIF" | e="TIFF" | e="BMP"
then return '<img src="'ImagePath'image.gif"' size 'alt="[img] ">'
when e="MPG" | e="MPEG" | e="AVI"
then return '<img src="'ImagePath'movie.gif"' size 'alt="[mov] ">'
otherwise
return '<img src="'ImagePath'unknown.gif"' size 'alt="[file]">'
end
extension: procedure
arg filename
/* If no period or only period is first char, then return "" */
if lastpos(".",filename)<2 then return ""
return translate(substr(filename, lastpos('.',filename)+1))
/************/
/* display the readmefile */
showdafile: /* display the file */
parse arg mlines
call lineout tempfile,' <hr> '
if readmefile_mess=0 | readmefile_mess="" then readmefile_mess=' Displaying: ' ||readmefile
if mlines = 0 then
nop
else do
call lineout tempfile,' <h3> ' readmefile_mess ' </h3> <pre> '
do mm=1 to mlines
call lineout tempfile,readmelines.mm
end
call lineout tempfile, ' </pre> '
if notdone=1 then
call lineout tempfile,' <br> <em> Only first ' mlines ' lines are displayed </em> '
end
call lineout tempfile,' <hr> '
return 0
error_1:
call lineout tempfile, "<h3>Could not get a file</h3"
call lineout tempfile, " <p> (probably a memory problem) "
call lineout tempfile, "<hr></body></html>"
call lineout tempfile /* close */
say " (GETAFILE) Memory problem ? "
foo=directory(olddir)
return 1
error_0:
if iscreate=0 then do
call lineout tempfile, "<h3>Could not get a file </h3>"
call lineout tempfile, " <p> The file directory does not exist: " adir
end
else
call lineout tempfile,' <br> Unavailable '
call lineout tempfile, "<hr></body></html>"
call lineout tempfile /* close */
say " DIR " adir " does not exist"
return 1
error_3:
call lineout tempfile, "<h3>Could not get a subdirectory</h3>"
call lineout tempfile, " <p> (probably a memory problem) "
call lineout tempfile, "<hr></body></html>"
call lineout tempfile /* close */
say " (GETAFILE) Memory problem ? "
return